VERSION = 3.00 _movers.hi'E*!Arial, 0, 9, 5, 15, 12, 32, 3, 0  _fieldmover _movers.hPixelsClass1 _supermover _fieldmover container _movers.vcx _movers.hi'E*!Arial, 0, 9, 5, 15, 12, 32, 3, 0  _tablemover _movers.hPixelsClass5 _fieldmover _tablemover`Top = 17 Left = 121 Height = 23 Width = 22 Caption = "..." TabIndex = 3 Name = "cmdOpen"  _tablemovercmdOpen _movers.hi'E*!Arial, 0, 9, 5, 15, 12, 32, 3, 0 _mover _movers.hPixelsClass7 _container_mover]BackStyle = 0 Caption = "" Height = 15 Left = 251 Top = 0 Width = 124 Name = "Label2" _moverLabel2label _base.vcx_label[BackStyle = 0 Caption = "" Height = 15 Left = 0 Top = 0 Width = 124 Name = "Label1" _moverLabel1label _base.vcx_labelbHeight = 92 Left = 256 MoverBars = .T. TabIndex = 4 Top = 15 Width = 121 Name = "lstRight" _moverlstRightlistbox _base.vcx_listboxvTop = 58 Left = 160 Height = 20 Width = 75 Caption = "< Remove" Enabled = .F. TabIndex = 3 Name = "cmdRemove" _mover cmdRemove commandbutton _base.vcx_commandbuttonaTop = 33 Left = 160 Height = 20 Width = 75 Caption = "Add >" TabIndex = 2 Name = "cmdAdd" _movercmdAdd3setfields setfieldsglobal skipmemo Do not include Memo fields in list. skipgeneral Do not include General fields in list. currentalias Current alias determined by ALIAS(). autoinit Automatically run on load. allowreadonly Allows for read-only datasource. currentdbc Current database file. refreshfields skiperror dbctable Name of table in DBC. cursortype Type of cursor. 1-local view, 2-remote view, 3-table. tabletype Returns table type - SYS(2029). multitable Whether to support multiple tables. savemessage *gettabledata Retrieves fields from table. *juststem Retrieves filename stem. *alert Displays a messagebox dialog. *addtoarray Adds item to array. *acolscan Scans specific column in array. *initvars Initializes variables used by movers. *initdata Initializes data. *setdataprops Sets data properties. *fieldchange Triggered when fields selected changes. *updatestatusbar Updates status bar.  commandbutton _base.vcxlabelqmaxitems Maximum number of items that can be selected. maxmessage Message to display if maximum items reached.  _movers.vcxaPROCEDURE Clear DIMENSION this.parent.aSelections[1,2] this.parent.aSelections[1] = "" ENDPROC PROCEDURE Init this.value="" ENDPROC PROCEDURE InteractiveChange IF EMPTY(THIS.VALUE) THIS.VALUE = THIS.LIST[1] ENDIF ENDPROC PROCEDURE DblClick this.Parent.cmdRemove.Click ENDPROC PROCEDURE OLEDragDrop LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord LOCAL oFoxControl IF oDataObject.GetFormat("VFP Source Object") oFoxControl = oDataObject.GetData("VFP Source Object") IF UPPER(oFoxControl.Name) = "LSTLEFT" this.Parent.cmdAdd.Click() ENDIF ENDIF ENDPROC  ~%;&U T CCꖡ T CT  T aT  T aT C Hb C 3T CCCꖡ Free Tables 6- C R.DBCCC %C R.DBCf T CC  Hw   C 2%TCC sourcenamefCC2b% !C9CTCC$TT  T  ULHASDBC CDBCALIASLOLDLOCK LOLDREFRESH ADBCTABLES CNEWTABLETHISPARENT OPENTABLETHISFORM LOCKSCREEN REFRESHFIELDS GETDBCALIASCBODATAVALUE GETDBCNAME GETDBCDATA LSTTABLES GETTABLEDATA TABLECHANGE GETFREEDATAENABLED LISTCOUNTClick,1"b!Qc2AaRAAQAB!Q2)currentalias Current alias for field choices. currentdbc Current database for field choices. maxfields Maximum number of fields allowed. showtags Whether to show existing index tags in addition to fields. tagname *updatemover ^atags[1,1]  _movers.vcx container container_commandbuttonPROCEDURE Click PARAMETER nPosition LOCAL cLstIdx,nLstPos, nPos cLstIdx = this.Parent.lstRight.ListIndex nLstPos = IIF(PCOUNT()#0 AND TYPE("m.nPosition")="N",nPosition,0) IF EMPTY(this.Parent.lstRight.value) OR this.Parent.lstRight.listindex = 0 RETURN ENDIF this.Parent.Updated = .t. * Add item to left list IF THIS.Parent.ValidItem() && but allows one to bypass adding item back IF THIS.Parent.UseArrays &&using array IF !EMPTY(this.parent.aChoices) DIMENSION this.parent.aChoices[ALEN(this.parent.aChoices)+1] ENDIF this.parent.aChoices[ALEN(this.parent.aChoices)] = this.Parent.lstRight.List[m.cLstIdx] *!* IF this.parent.lstLeft.sorted IF this.parent.sortLeft =ASORT(this.parent.aChoices) ENDIF this.Parent.lstLeft.rowsourcetype = 5 this.Parent.lstLeft.rowsource = "this.parent.aChoices" ELSE IF nLstPos = 0 this.Parent.lstLeft.AddListItem(this.Parent.lstRight.List[m.cLstIdx]) this.Parent.lstLeft.ListItemID = ; this.Parent.lstLeft.IndexToItemID[this.Parent.lstLeft.ListCount] ELSE this.Parent.lstLeft.AddItem(this.Parent.lstRight.List[m.cLstIdx],m.nLstPos) this.Parent.lstLeft.ListItemID = ; this.Parent.lstLeft.IndexToItemID[1] ENDIF ENDIF this.Parent.lstLeft.Value = this.Parent.lstRight.List[m.cLstIdx] ENDIF * Reset selections array IF ALEN(this.parent.aSelections,1) = 1 this.parent.aSelections[1,1] = "" ELSE * We must find the right one nPos = ASCAN(this.parent.aSelections,this.Parent.lstRight.ListItemId) IF m.nPos # 0 nPos = ASUBSCRIPT(this.parent.aSelections,m.nPos,1) ELSE nPos = this.Parent.lstRight.ListItemId ENDIF =ADEL(this.parent.aSelections,m.nPos) DIMENSION this.parent.aSelections[ALEN(this.parent.aSelections,1)-1,2] ENDIF * Remove item from list on right this.parent.oldRSelectedItem = this.Parent.lstRight.ListIndex this.Parent.lstRight.RemoveItem(m.cLstIdx) this.Parent.Refresh ENDPROC _commandbuttonBackStyle = 0 Caption = "\ 0 dimension aSelections[this.lstRight.ListCount,1] for m.i = 1 to alen(aSelections,1) aSelections[m.i,1] = this.lstRight.List[m.i] endfor endif return this.lstRight.ListCount ENDPROC PROCEDURE sizetocontainer private m.iScaleMode m.iScaleMode = thisform.ScaleMode thisform.ScaleMode = 3 && Pixels if empty(this.Label1.Caption) this.Label1.Height = 0 endif this.Label2.Height = this.Label1.Height this.Label1.Top = 0 this.Label2.Top = 0 this.lstLeft.Top = this.Label1.Height this.lstRight.Top = this.lstLeft.Top this.lstLeft.Height = this.Height - this.Label1.Height this.lstRight.Height = this.lstLeft.Height this.lstLeft.Width = int((this.Width - this.cmdAdd.Width - 36) / 2) this.lstRight.Width = this.lstLeft.Width this.lstLeft.Left = 0 this.lstRight.Left = this.Width - this.lstRight.Width this.Label2.Left = this.lstRight.Left this.Label1.Width = this.lstLeft.Width this.Label2.Width = this.Label1.Width this.cmdAdd.Left = int((this.Width - this.cmdAdd.Width) / 2) this.cmdRemove.Left = this.cmdAdd.Left this.cmdRemove.Height = this.cmdAdd.Height this.cmdRemove.Width = this.cmdAdd.Width this.cmdAdd.Top = this.Label1.Height + ; int((this.lstLeft.Height - ((this.cmdAdd.Height * 2) + 6)) / 2) this.cmdRemove.Top = this.cmdAdd.Top + this.cmdAdd.Height + 6 thisform.ScaleMode = m.iScaleMode ENDPROC PROCEDURE poplist * this routine is used to expedite the process of * populating a Listbox using the AddItem method * for RowSourceType = 0. LPARAMETER aListArray,oLstRef EXTERNAL ARRAY aListArray Local nStep, cTmpListStr, i private cTmpListStr,i,m.nStep m.cTmpListStr = "" m.i = 0 *--v-darylm modified 9/8/99 *--added support for singly dimensioned arrays m.nStep = alen(aListArray,2) for m.i= 1 to alen(aListArray) step Iif(m.nStep==0,1,m.nStep) m.oLstRef.AddItem(aListArray[m.i]) endfor *!* for m.i=1 to alen(aListArray,1) *!* m.oLstRef.AddItem(aListArray[m.i,1]) *!* endfor ENDPROC PROCEDURE validitem * Stub here, but is used by TBLMOVER under certain conditions * to prevent item from being added back to left list. For example, * where the item is a field which is not part of the current table. RETURN .T. ENDPROC PROCEDURE Refresh if type("this.oldLSelectedItem")='L' this.oldLSelectedItem=0 endif if type("this.oldRSelectedItem")='L' this.oldRSelectedItem=0 endif if this.lstLeft.ListCount = 0 AND this.lstRight.ListCount = 0 this.lstLeft.Enabled = .F. this.lstRight.Enabled = .F. else this.lstLeft.Enabled = .T. this.lstRight.Enabled = .T. endif if this.lstLeft.ListCount = 0 this.cmdAdd.Enabled = .f. else this.cmdAdd.Enabled = .t. if this.oldLSelectedItem>0 this.lstLeft.ListIndex=this.oldLSelectedItem if this.lstLeft.ListIndex=0 this.lstLeft.ListIndex=this.oldLSelectedItem-1 if this.lstLeft.ListIndex=0 this.lstLeft.ListIndex=1 endif endif endif endif if this.lstRight.ListCount = 0 this.cmdRemove.Enabled = .f. else this.cmdRemove.Enabled = .t. if this.oldRSelectedItem>0 this.lstRight.ListIndex=this.oldRSelectedItem if this.lstRight.ListIndex=0 this.lstRight.ListIndex=this.oldRSelectedItem-1 if this.lstRight.ListIndex=0 this.lstRight.ListIndex=1 endif endif endif endif this.oldLSelectedItem=0 this.oldRSelectedItem=0 ENDPROC PROCEDURE Init DIMENSION THIS.aSelections[1,2] DIMENSION THIS.aChoices[1] ENDPROC # ##%2"HU         J( J( J( 3T CCTHIS.SETFIELDSbL -69T CCTHIS.SETFIELDSGLOBALbL -62T CC THIS.SKIPMEMObL -65T CCTHIS.SKIPGENERALbL -6 C1%CTHIS.RefreshFieldsbL B%C_ T-T-T-% W T-T-T-B Hp G %CCnG CFIELDSvONGC %   GCT +CC n T C n$T CC C= ="T C C= \%C= T C T C  C  0C    %CC ; C #T C C f!T C  T C "'T  GG!%2     C. (C.%CC />CC /U!T CC /|T C /9 (C 5 H, C  G 2  .% C  M  . C CC   % h V!C (R/%C C.C N%C T C  C %CC J  C!!%CC C "T#C$U%INTMPLENATMPFLDSCTMPFLD LSETFIELDS LSETGLOBAL CCALCNAME CCALCEXPR LSKIPMEMOLSKIPGEN AWIZFLIST ACALCFIELDS APICKFIELDS LNNUMFIELDSTHIS SETFIELDSSETFIELDSGLOBALSKIPMEMO SKIPGENERAL SETDATAPROPS REFRESHFIELDS CURRENTALIASLSTLEFTCLEARENABLEDCMDADD CMDADDALL MULTITABLELSTRIGHT CMDREMOVE CMDREMOVEALL ADDTOARRAY ASELECTIONSREFRESH INITCHOICESVALUELIST %C\ I&T C C\ \%C: &T C C: \%C. %T C C. \BCC fUFILNAMEQT T-C xT UPMESSAGE OLDLOCKSCRNTHISFORM LOCKSCREEN!%C CC ET C%CTC CT  BU AADDTOARRAY SCONTENTSIROW5%CwztcolbN= TT  +aT C   H ! C  !2T   B UWZTARRWZTEXPRWZTCOLAPOS2TCC THIS.UPDATEDbL -68TCCTHIS.ALLOWREADONLYbL -64TCCTHIS.SETFIELDSbL -6:TCCTHIS.SETFIELDSGLOBALbL -63TCC THIS.SKIPMEMObL -66TCCTHIS.SKIPGENERALbL -64TCCTHIS.SKIPERRORbL -6U THISUPDATED ALLOWREADONLY SETFIELDSSETFIELDSGLOBALSKIPMEMO SKIPGENERAL SKIPERROR ASELECTIONSD C%CC( C= CUTHISINITVARS SETDATAPROPS GETTABLEDATA:TC*TCCCCDatabase6 HF3 C C TCC SourceNamefTC SourceTypeTC] C TTTC]23TTTUTHIS CURRENTALIAS CURRENTDBCDBCTABLE CURSORTYPE TABLETYPE UNBUTTONA%C STATUS BARvON C m.cArrItembC  TC C. =%C  TCTC sourcename TCdatabase %C  j CTC %QTC f T.G&(CC  C !6C U CARRITEM CTMPALIASCDBC CDBCALIASCSOURCEADBCNPOSTHIS MULTITABLE5%CG&(.G&(UTHIS SAVEMESSAGE%2CCEBT CEeCError #CC Z in   (CC Z):  0Microsoft Visual FoxProxB(UNERRORCMETHODNLINETHIS SKIPERRORALERTCMESSAGEz CTCMESSAGEv,%C THIS.AUTOINITbL ^ Cs CUTHIS SAVEMESSAGEAUTOINITINITVARSINITDATA % #BaTCTC% T TC #BCC.C UNGETIDXNPOSTHIS MULTITABLELSTRIGHT ITEMIDTOINDEX LISTITEMID ASELECTIONSCUTHISPARENTCMDADDCLICK,%C 0BC%JT C C.CC  C U THISPARENTLSTLEFT LISTINDEXVALUE _SUPERMOVERCMDADDCLICK MULTITABLE ASELECTIONS FIELDCHANGE[,%C 0BCCU THISPARENTLSTRIGHT LISTINDEXVALUE _SUPERMOVER CMDREMOVECLICK FIELDCHANGECUTHISPARENT CMDREMOVECLICK "%  1BTCTC4TC  C 6#CC U NGETIDXNPOSTHISPARENT MULTITABLE LISTITEMID ITEMIDTOINDEX ASELECTIONSUPDATESTATUSBAR 6TCCCC6C%+C( 9T C.C C U NARRLENITHISPARENT ASELECTIONS _SUPERMOVER CMDADDALLCLICK MULTITABLE FIELDCHANGEzT'%CC D)C(@*%CC.C <C  %CT!8C (CC T- ( #%C   &T C  T  Ta!%  C  P#T C T CCUICVALUE LFOUNDFLDTHISPARENTLSTRIGHTVALUE MULTITABLE ASELECTIONS REMOVEITEM _SUPERMOVER CMDREMOVEALLCLICKLSTLEFT LISTCOUNTLIST LISTINDEX FIELDCHANGEREFRESH gettabledata,juststemb alertT addtoarray acolscan initvars initdata setdatapropsR fieldchangeupdatestatusbarDestroyError(Init validitemlstleft.DblClick cmdadd.Click+cmdremove.ClickVlstright.DblClick  lstright.WhenEcmdaddall.Clickmcmdremoveall.Click111112!QAA#AAAaaAaAaaAA!!1qA1AQAaaA!AAAQAAAAA1!AA1AAAAABA3aAaAQA4qq!!3QAAAA3qA1AAQAA3#A1aAb3A3111A3q2qA!qAAA2!aA2AAsQb3A3qA1A2213AA3A22AA1213"AArA12a3AA22bqAqAAAA1aAAA1aA21oo {(~t g=[!27!<^!z!N!#R A##`#$gB$%k%g'y'',)#8 Vs% f ` UX0TCC this.sortleftbL a6%C % CT'TTHIS.Parent.aChoices'T-C % #TaT C C U ACHOICESLSORTEDTHISSORTLEFT USEARRAYSLSTLEFT ROWSOURCETYPE ROWSOURCESORTEDPOPLIST LISTITEMID INDEXTOITEMIDREFRESHCTCC(C%T C  T   CU ASELECTIONSITHISPOPLISTLSTRIGHT LISTITEMIDLSTLEFT INDEXTOITEMIDREFRESH45% (C(T C BU ASELECTIONSITHISLSTRIGHT LISTCOUNTLIST 5 T T%CSTTTTT T   T T  +T C  $ 8T  T  T   T  T  T  'T C   8T  T T  >T C   8'T  T U ISCALEMODETHISFORM SCALEMODETHISLABEL1CAPTIONHEIGHTLABEL2TOPLSTLEFTLSTRIGHTWIDTHCMDADDLEFT CMDREMOVE 5 T T T C8 (CC  6CC  U ALISTARRAYOLSTREFNSTEP CTMPLISTSTRIADDITEM BaU)%Cthis.oldLSelectedItembL9T)%Cthis.oldRSelectedItembLvT(% T-T-TaTa%T-Ta%T%T%T%T -T a%T%T%TTTU THISOLDLSELECTEDITEMOLDRSELECTEDITEMLSTLEFT LISTCOUNTLSTRIGHTENABLEDCMDADD LISTINDEX CMDREMOVE)UTHIS ASELECTIONSACHOICES initchoices,initselections getselections6sizetocontainer poplist= validitem4RefreshBInitv 1qra1A1qqAA2qqqQA2qqqAA3!R1A111rq"3TA7u2AAArAaqq1AAAArAaqq1AAAA3a2Di!'+O 3Gm WR oT v3p) 5%s*U%5BT aT T " (+T C  % %3C TC(CC"C  % CT*TTHIS.Parent.aChoicesjT-C% fTaTaT  %T T -U ALISTITEMSLSORTEDNARRLENCVALUEITHISPARENTLSTRIGHT LISTCOUNTTHISFORM LOCKSCREENSORTLEFTVALUELIST USEARRAYSLSTLEFTACHOICES ROWSOURCETYPE ROWSOURCESORTEDPOPLISTCLEARUPDATED LISTITEMIDREFRESHClick,1qAA1b!A21a!A!AaAAAAaA2l)[ BB;%4US% 9B?% %    :%C !CTHIS.Parent.MaxMessagebC C xBT aT T -T%jCC  " ( +T C CC Ta% TT -% CC C(C (T C #T  TC"TCC  ( 1T C  1T C  % T aT   T -U ALISTITEMSLSORTEDNTMPLENNTMPLEN2CVALUEITHISPARENTLSTLEFT LISTCOUNTMAXITEMSLSTRIGHT MAXMESSAGETHISFORM LOCKSCREENSORTEDVALUE USEARRAYSACHOICESLISTCLEARPOPLISTUPDATED LISTITEMID ASELECTIONS INDEXTOITEMIDREFRESHClick,1AA!AAAbAa2q!AA2aA1A!AAAA2f)B mm% CnU/%C THIS.MaxItemsbN  ?T/%CTHIS.MaxMessagebC C BTYou cannot select more than CCZ items. CUTHISMAXITEMS MAXMESSAGE5T T%CQTTTTT T   T T  +T C  $ 8T  T  T   T  T  T  'T C   8T  T  T  T T T T  T  T  >T C   8'T  'T'TT U ISCALEMODETHISFORM SCALEMODETHISLABEL1CAPTIONHEIGHTLABEL2TOPLSTLEFTLSTRIGHTWIDTHCMDADDLEFT CMDADDALL CMDREMOVE CMDREMOVEALL C%BT-T-[Ta%T-T-TaUTHISLSTLEFT LISTCOUNT CMDADDALLENABLEDDEFAULTLSTRIGHT CMDREMOVEALL6% :%C !CTHIS.Parent.MaxMessagebC CxB CUTHISPARENTMAXITEMSLSTRIGHT LISTCOUNT MAXMESSAGEInit,sizetocontainerRefresh> cmdadd.ClickI1A!A2q"S1A111rqqq"5qArA2c!AAA1M s-A;  Q)m PROCEDURE updatemover * Use this routine if you want to show tags and fields in the Sort Mover. * The routine assumes that you have set the CurrentAlias property. LOCAL aTagList,nTotalTags,i,nSaveAlias LOCAL aFlds,olstref IF EMPTY(ALIAS()) OR EMPTY(THIS.CurrentAlias) RETURN ENDIF nSaveAlias = ALIAS() IF ALIAS() # UPPER(THIS.CurrentAlias) SELECT (This.CurrentAlias) ENDIF THIS.ShowTags = .T. THIS.UseArrays = .F. THIS.TagName = "" This.lstRight.CLEAR() m.oLstRef = This.lstLeft m.oLstRef.Clear() m.oLstRef.Sorted = .F. m.oLstRef.Value = "" * Add index tags if available DIMENSION aTagList[1] aTagList[1] = "" nTotalTags = TAGCOUNT('') DIMENSION aFlds[1] =AFIELDS(aFlds) DIMENSION THIS.aTags[1] THIS.aTags[1] = "" * Add regular fields checking to see if first in taglist FOR i = 1 TO ALEN(aFlds,1) IF INLIST(aFlds[m.i,2],"M","G") * skip memo and general fields LOOP ELSE m.oLstRef.AddItem(PROPER(aFlds[m.i,1])) ENDIF ENDFOR * Add index tags IF m.nTotalTags > 0 DIMENSION aTagList[m.nTotalTags] DIMENSION THIS.aTags[m.nTotalTags,2] IF m.oLstRef.Listcount>0 m.oLstRef.AddItem("\-") ENDIF FOR i = 1 TO m.nTotalTags aTagList[m.i] = KEY(m.i) THIS.aTags[m.i,1] = LOWER(KEY(m.i))+TAGDELIM THIS.aTags[m.i,2] = LOWER(TAG(m.i)) m.oLstRef.AddItem(LOWER(KEY(m.i))+TAGDELIM) ENDFOR ENDIF IF m.oLstRef.ListCount > 0 m.oLstRef.ListIndex = 1 ENDIF THIS.Refresh() SELECT (m.nSaveAlias) ENDPROC PROCEDURE Refresh DODEFAULT() LOCAL nPos * don't re-enable it if already disabled. IF THIS.cmdAdd.Enabled If ATC(TAGDELIM,THIS.lstRight.Value)#0 AND ; This.ShowTags AND THIS.lstRight.ListCount > 0 * check if we have a tag selected nPos = ASCAN(THIS.aTags,THIS.lstRight.Value) IF m.nPos # 0 THIS.cmdAdd.Enabled = .F. THIS.TagName = THIS.aTags[m.nPos+1] ENDIF ENDIF IF THIS.cmdAdd.Enabled THIS.cmdAdd.Enabled = (THIS.lstRight.ListCount0 AND ; ATCC(TAGDELIM,THIS.PARENT.lstLeft.Value)#0 IF ASCAN(THIS.PARENT.aTags,THIS.PARENT.lstLeft.Value)#0 OR; ASCAN(THIS.PARENT.aTags,THIS.PARENT.lstRight.List[1])#0 =MESSAGEBOX(C_NOTAG_LOC) RETURN ENDIF ENDIF _MOVER.cmdAdd::Click ENDPROC PROCEDURE cmdRemove.Click IF This.Parent.ShowTags THIS.Parent.TagName = "" IF ASCAN(THIS.Parent.aTags,THIS.Parent.lstRight.Value)=0 _MOVER.cmdRemove::Click(1) RETURN ENDIF ENDIF _MOVER.cmdRemove::Click ENDPROC wPROCEDURE Click LOCAL aListItems,lSorted,nArrLen,cValue,i IF this.Parent.lstRight.ListCount = 0 RETURN ENDIF THISFORM.LOCKSCREEN = .T. lSorted = this.parent.sortLeft *v-darylm: lSorted = this.Parent.lstLeft.Sorted cValue = this.Parent.lstRight.Value DIMENSION aListItems[this.Parent.lstRight.ListCount,1] for m.i = 1 to this.Parent.lstRight.ListCount aListItems[m.i,1] = this.Parent.lstRight.List[m.i] endfor IF This.Parent.UseArrays IF this.Parent.lstLeft.ListCount = 0 DIMENSION THIS.Parent.aChoices[1] =ACOPY(aListItems,THIS.Parent.aChoices) ELSE nArrLen = ALEN(THIS.Parent.aChoices,1)+1 DIMENSION THIS.Parent.aChoices[ALEN(THIS.Parent.aChoices,1)+ALEN(aListItems,1)] =ACOPY(aListItems,THIS.Parent.aChoices,1,-1,m.nArrLen) ENDIF IF m.lSorted =ASORT(THIS.Parent.aChoices) ENDIF this.Parent.lstLeft.RowSourceType = 5 this.Parent.lstLeft.RowSource = "THIS.Parent.aChoices" ELSE this.Parent.lstLeft.Sorted = .F. && performance is better with Sorted off this.Parent.POPLIST(@aListItems,this.Parent.lstLeft) IF m.lSorted this.Parent.lstLeft.Sorted = .T. ENDIF ENDIF this.Parent.lstRight.Clear this.Parent.Updated = .t. this.parent.lstleft.value = m.cValue * Test for valid setting IF this.Parent.lstleft.listitemid = 0 this.Parent.lstleft.listitemid = 1 ENDIF this.Parent.Refresh THISFORM.LOCKSCREEN = .F. ENDPROC ,PROCEDURE gettabledata * This routine also assumes that the parent * database is already selected upon being called. LOCAL i,ntmplen,atmpflds,ctmpfld,lSetFields,lSetGlobal LOCAL cCalcName,cCalcExpr,lSkipMemo,lSkipGen LOCAL aWizFList,aCalcFields,aPickFields, lnNumFields DIMENSION aWizFList[1] DIMENSION aCalcFields[1,2] DIMENSION aPickFields[1,1] STORE "" TO aWizFList STORE "" TO aCalcFields STORE "" TO aPickFields m.lSetFields = IIF(TYPE("THIS.SETFIELDS")="L",THIS.SETFIELDS,.F.) m.lSetGlobal = IIF(TYPE("THIS.SETFIELDSGLOBAL")="L",THIS.SETFIELDSGLOBAL,.F.) m.lSkipMemo = IIF(TYPE("THIS.SKIPMEMO")="L",THIS.SKIPMEMO,.F.) m.lSkipGen = IIF(TYPE("THIS.SKIPGENERAL")="L",THIS.SKIPGENERAL,.F.) THIS.SetDataProps() * Don't refresh fields IF TYPE("THIS.RefreshFields")= "L" AND !THIS.RefreshFields RETURN ENDIF * Clear controls if needed IF EMPTY(THIS.CurrentAlias) THIS.LstLeft.Clear THIS.LstLeft.Enabled = .F. THIS.cmdAdd.Enabled = .F. THIS.cmdAddAll.Enabled = .F. IF !THIS.MultiTable THIS.LstRight.Clear THIS.LstRight.Enabled = .F. THIS.cmdRemove.Enabled = .F. THIS.cmdRemoveAll.Enabled = .F. ENDIF RETURN ENDIF * Check if SET FIELDS ON originally. Note: this * should be OFF during duration of wizard. DO CASE CASE m.lSetFields SET FIELDS ON * check if they opened a new database with SET FIELDS ON IF EMPTY(FLDLIST()) SET FIELDS OFF ENDIF CASE SET("FIELDS") = "ON" SET FIELDS OFF ENDCASE =AFIELDS(aWizFList) * Check for Calculated fields * Note: SET FIELDS GLOBAL must be on initially. IF m.lSetGlobal AND m.lSetFields SET FIELDS GLOBAL =AFIELDS(aTmpFlds) m.i = 1 DO WHILE !EMPTY(FLDLIST(m.i)) m.ctmpfld = FLDLIST(m.i) m.cCalcName = ALLTRIM(LEFT(m.ctmpfld ,AT('=',m.ctmpfld )-1)) m.cCalcExpr = SUBST(m.ctmpfld ,AT('=',m.ctmpfld )+1) IF AT('=',m.ctmpfld )#0 &&we have a calculated field m.ntmplen=ALEN(aWizFList) lnNumFields = ALEN(aWizFList, 2) DIMENSION aWizFList[ALEN(aWizFList,1)+1, lnNumFields ] =ACOPY(atmpflds,aWizFList, (m.i-1) * lnNumFields+1, lnNumFields, m.ntmplen+1) IF !EMPTY(aCalcFields[1,1]) DIMENSION aCalcFields[ALEN(aCalcFields,1)+1,2] ENDIF aCalcFields[ALEN(aCalcFields,1),1]=UPPER(m.cCalcName) aCalcFields[ALEN(aCalcFields,1),2]=m.cCalcExpr m.cCalcExpr=STRTRAN(m.cCalcExpr,'"',"'") ENDIF m.i = m.i + 1 ENDDO SET FIELDS LOCAL SET FIELDS OFF ENDIF * Optimize here if all fields can be used IF !_DOS AND !m.lSkipGen AND !m.lSkipMemo DIMENSION aPickFields[FCOUNT(),1] FOR m.i=1 TO FCOUNT() IF LEN(FIELD(m.i)) = LENC(FIELD(m.i)) aPickFields[m.i,1] = PROPER(FIELD[m.i]) ELSE aPickFields[m.i,1] = FIELD[m.i] ENDIF ENDFOR ELSE FOR m.i=1 TO ALEN(aWizFList,1) * Get fields array -- exclude General fields * or Memo fields based on property settings. DO CASE CASE aWizFList[m.i,2]=DT_GENERAL AND (_DOS OR m.lSkipGen) LOOP CASE aWizFList[m.i,2]=DT_MEMO AND m.lSkipMemo LOOP ENDCASE THIS.AddToArray(@aPickFields,PROPER(aWizFList[m.i,1])) ENDFOR ENDIF THIS.LstLeft.Clear IF !THIS.MultiTable THIS.LstRight.Clear ELSE * Check for which fields are already selected FOR i = ALEN(aPickFields) TO 1 STEP - 1 IF ASCAN(THIS.aSelections,ALIAS()+"."+aPickFields[m.i], 1, 3)#0 IF ALEN(aPickFields) = 1 aPickFields[1] = "" ELSE =ADEL(aPickFields,m.i) DIMENSION aPickFields[ALEN(aPickFields)-1] ENDIF IF EMPTY(aPickFields[1]) THIS.LstLeft.Clear THIS.Refresh() EXIT ENDIF ENDIF ENDFOR ENDIF IF !EMPTY(aPickFields[1]) THIS.initChoices(@aPickFields) THIS.lstLeft.Value = THIS.lstLeft.List[1] ENDIF ENDPROC PROCEDURE juststem * Return just the stem name from "filname" LPARAMETERS m.filname IF RATC('\',m.filname) > 0 m.filname = SUBSTR(m.filname,RATC('\',m.filname)+1,255) ENDIF IF RATC(':',m.filname) > 0 m.filname = SUBSTR(m.filname,RATC(':',m.filname)+1,255) ENDIF IF AT('.',m.filname) > 0 m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1) ENDIF RETURN ALLTRIM(UPPER(m.filname)) ENDPROC PROCEDURE alert LPARAMETER pMessage LOCAL oldLockScrn m.oldLockScrn = THISFORM.LOCKSCREEN THISFORM.LOCKSCREEN = .F. =MESSAGEBOX(m.pMessage) THISFORM.LOCKSCREEN = m.oldLockScrn ENDPROC PROCEDURE addtoarray * Inserts an array element into an array. * For 1-D array LPARAMETER aAddToArray,sContents,iRow IF ALEN(aAddToArray) = 1 AND EMPTY(aAddToArray[1]) aAddToArray[1]=m.sContents ELSE DIMENSION aAddToArray[ALEN(aAddToArray)+1,1] IF PARAM()=2 aAddToArray[ALEN(aAddToArray)]=m.sContents ELSE =AINS(aAddToArray,iRow+1) aAddToArray[m.iRow+1]=m.sContents ENDIF ENDIF RETURN ENDPROC PROCEDURE acolscan * This function does an ASCAN for a specific row where * wztarr - array to scan * wztexpr - expression to scan * wztcol - column to scan LPARAMETER wztarr,wztexpr,wztcol PRIVATE apos IF TYPE('wztcol')#'N' wztcol =1 ENDIF m.apos = 1 DO WHILE .T. m.apos = ASCAN(wztarr,m.wztexpr,m.apos) DO CASE CASE m.apos=0 &&did not find match EXIT CASE ASUBSCRIPT(wztarr,m.apos,2)=m.wztcol EXIT OTHERWISE m.apos=m.apos+1 ENDCASE ENDDO RETURN m.apos ENDPROC PROCEDURE initvars * Initialize instance variables to proper data types THIS.UPDATED = IIF(TYPE("THIS.UPDATED")="L",THIS.UPDATED ,.F.) THIS.ALLOWREADONLY = IIF(TYPE("THIS.ALLOWREADONLY")="L",THIS.ALLOWREADONLY,.F.) THIS.SETFIELDS = IIF(TYPE("THIS.SETFIELDS")="L",THIS.SETFIELDS,.F.) THIS.SETFIELDSGLOBAL = IIF(TYPE("THIS.SETFIELDSGLOBAL")="L",THIS.SETFIELDSGLOBAL,.F.) THIS.SKIPMEMO = IIF(TYPE("THIS.SKIPMEMO")="L",THIS.SKIPMEMO,.F.) THIS.SKIPGENERAL = IIF(TYPE("THIS.SKIPGENERAL")="L",THIS.SKIPGENERAL,.F.) THIS.SKIPERROR = IIF(TYPE("THIS.SKIPERROR")="L",THIS.SKIPERROR,.F.) DIMENSION THIS.aSelections[1,2] ENDPROC PROCEDURE initdata * This is a stub. Use with subclassed TblMover. THIS.InitVars() IF EMPTY(ALIAS()) THIS.SetDataProps() ELSE THIS.GetTableData() ENDIF ENDPROC PROCEDURE setdataprops * SetDataProps set various data properties THIS.CurrentAlias = ALIAS() THIS.CurrentDBC = IIF(EMPTY(ALIAS()),"",CURSORGETPROP("Database")) DO CASE CASE !EMPTY(THIS.CurrentAlias) AND !EMPTY(THIS.CurrentDBC) THIS.DbcTable = UPPER(CURSORGETPROP("SourceName")) &&name as stored in DBC THIS.CursorType = CURSORGETPROP("SourceType") &&1-local,2-remote,3-table THIS.TableType = SYS(2029) &&3.0 table = 48 CASE !EMPTY(THIS.CurrentAlias) &&free table THIS.DbcTable = "" THIS.CursorType = 3 &&table THIS.TableType = SYS(2029) &&3.0 table OTHERWISE &¬hing opened THIS.DbcTable = "" THIS.CursorType = 0 THIS.TableType = 0 ENDCASE ENDPROC PROCEDURE fieldchange LPARAMETER nButton ENDPROC PROCEDURE updatestatusbar LPARAMETER cArrItem LOCAL cTmpAlias,cDBC,cDBCAlias,cSource,aDBC,nPos IF THIS.MultiTable AND SET("STATUS BAR") = "ON" AND TYPE("m.cArrItem") = "C" cTmpAlias = LEFT(m.cArrItem,AT(".",m.cArrItem)-1) IF EMPTY(m.cTmpAlias) cTmpAlias = ALIAS() ENDIF cSource = CURSORGETPROP("sourcename",m.cTmpAlias) cDBC = CURSORGETPROP("database",m.cTmpAlias) IF !EMPTY(m.cDBC) DIMENSION aDBC[1] =ADATABASES(aDBC) nPos = ASCAN(aDBC,m.cDBC, 1, 3) IF nPos # 0 cDBCAlias = aDBC(m.nPos-1) ELSE cDBCAlias = "" ENDIF ENDIF SET MESSAGE TO IIF(EMPTY(m.cDBCAlias),"",PROPER(m.cDBCAlias)+"!") + PROPER(m.cSource) ENDIF ENDPROC PROCEDURE Destroy IF EMPTY(THIS.SaveMessage) SET MESSAGE TO ELSE SET MESSAGE TO THIS.SaveMessage ENDIF ENDPROC PROCEDURE Error LPARAMETERs nError, cMethod, nLine *- Trap for error opening file IF THIS.SKIPERROR THIS.ALERT(MESSAGE()) RETURN ENDIF *- Error local cMessage m.cMessage = message() =MessageBox(ERRORMESSAGE_LOC, MB_ICONEXCLAMATION + MB_OK, ERRORTITLE_LOC) RETURN TO MASTER ENDPROC PROCEDURE Init DODEFAULT() THIS.SaveMessage = SET("MESSAGE",1) IF TYPE("THIS.AUTOINIT") = "L" AND !THIS.AUTOINIT THIS.InitVars() ELSE THIS.InitData() ENDIF ENDPROC PROCEDURE validitem LOCAL nGetIdx,nPos IF !THIS.MultiTable RETURN .T. ENDIF nGetIdx = THIS.lstright.ItemIdToIndex(THIS.lstRight.ListItemId) * We must locate correct array element to check nPos = ASCAN(THIS.aSelections,THIS.lstRight.ListItemId) IF m.nPos = 0 nPos = m.nGetIdx ELSE nPos = ASUBSCRIPT(THIS.aSelections,m.nPos,1) ENDIF RETURN ATC(ALIAS()+".",THIS.aSelections[m.nPos,1])#0 ENDPROC PROCEDURE lstleft.DblClick THIS.Parent.cmdAdd.Click() ENDPROC PROCEDURE cmdadd.Click IF This.Parent.lstLeft.ListIndex = 0 OR EMPTY(THIS.Parent.lstLeft.Value) RETURN ENDIF _SUPERMOVER.cmdAdd::Click() * Update selected fields array with DBC and Table alias IF THIS.Parent.MultiTable THIS.Parent.aSelections[ALEN(THIS.Parent.aSelections,1),1] = ; ALIAS() + "." + THIS.Parent.aSelections[ALEN(THIS.Parent.aSelections,1),1] ENDIF THIS.Parent.FieldChange(1) ENDPROC PROCEDURE cmdremove.Click IF This.Parent.lstRight.ListIndex = 0 OR EMPTY(THIS.Parent.lstRight.Value) RETURN ENDIF _SUPERMOVER.cmdRemove::Click() THIS.Parent.FieldChange(3) ENDPROC PROCEDURE lstright.DblClick THIS.Parent.cmdRemove.Click() ENDPROC PROCEDURE lstright.When LOCAL nGetIdx,nPos IF !THIS.Parent.MultiTable OR THIS.ListItemId = 0 RETURN ENDIF nGetIdx = THIS.ItemIdToIndex(THIS.ListItemId) * We must locate correct array element to check nPos = ASCAN(THIS.Parent.aSelections,THIS.ListItemId) nPos = IIF(m.nPos = 0,m.nGetIdx,ASUBSCRIPT(THIS.Parent.aSelections,m.nPos,1)) THIS.Parent.UpdateStatusBar(THIS.Parent.aSelections[m.nPos,1]) ENDPROC PROCEDURE cmdaddall.Click LOCAL nArrLen,i nArrLen = IIF(EMPTY(THIS.Parent.aSelections[1]),1,ALEN(THIS.Parent.aSelections,1)+1) _SUPERMOVER.cmdAddAll::Click() * Update for multi fields IF THIS.Parent.MultiTable FOR i = ALEN(THIS.Parent.aSelections,1) TO m.nArrLen STEP -1 THIS.Parent.aSelections[m.i,1] = ALIAS() + "." + THIS.Parent.aSelections[m.i,1] ENDFOR ENDIF THIS.Parent.FieldChange(2) ENDPROC PROCEDURE cmdremoveall.Click * Remove fields which do not belong to current table first! LOCAL i,cValue,lFoundFld cValue = this.Parent.lstRight.Value IF THIS.Parent.MultiTable AND !EMPTY(THIS.Parent.aSelections[1]) FOR i = ALEN(THIS.Parent.aSelections,1) TO 1 STEP -1 IF ATC(ALIAS()+".",THIS.Parent.aSelections[m.i,1])=0 THIS.Parent.lstRight.RemoveItem(m.i) IF ALEN(THIS.Parent.aSelections,1) = 1 THIS.Parent.aSelections[1] = "" EXIT ELSE =ADEL(THIS.Parent.aSelections,m.i) DIMENSION THIS.Parent.aSelections[ALEN(THIS.Parent.aSelections,1)-1,2] ENDIF ENDIF ENDFOR ENDIF _SUPERMOVER.cmdRemoveAll::Click() * if current value is not a from the current table, * default to first item in list lFoundFld=.F. FOR i = 1 TO this.Parent.lstLeft.ListCount IF this.Parent.lstLeft.List[m.i] = m.cValue this.Parent.lstLeft.Value = this.Parent.lstLeft.List[m.i] this.Parent.lstLeft.listindex = m.i lFoundFld=.T. EXIT ENDIF ENDFOR IF !m.lFoundFld OR EMPTY(m.cValue) this.Parent.lstLeft.Value = this.Parent.lstLeft.List[1] this.Parent.lstLeft.listindex = 1 ENDIF THIS.Parent.FieldChange(4) THIS.Parent.Refresh() ENDPROC 7Width = 466 Height = 140 SpecialEffect = 2 excldbf = ("") refreshcurrent = (.T.) allowviews = (.T.) viewnodata = (.T.) allowquery = (.F.) exclusiveset = 0 refreshfields = (.T.) dbctable = ("") Name = "_tablemover" lstleft.Height = 123 lstleft.Left = 152 lstleft.TabIndex = 6 lstleft.Top = 16 lstleft.Width = 133 lstleft.ItemTips = .T. lstleft.Name = "lstleft" cmdadd.Top = 34 cmdadd.Left = 298 cmdadd.Width = 22 cmdadd.TabIndex = 7 cmdadd.Name = "cmdadd" cmdremove.Top = 80 cmdremove.Left = 298 cmdremove.Width = 22 cmdremove.TabIndex = 9 cmdremove.Name = "cmdremove" lstright.Height = 123 lstright.Left = 332 lstright.TabIndex = 12 lstright.Top = 16 lstright.Width = 133 lstright.ItemTips = .T. lstright.Name = "lstright" label1.Caption = "\0 AND; (THIS.Parent.lstRight.ListCount+1)>this.Parent.MaxItems IF !EMPTY(THIS.Parent.MaxMessage) AND TYPE("THIS.Parent.MaxMessage")="C" MESSAGEBOX(THIS.Parent.MaxMessage) ENDIF RETURN ENDIF DODEFAULT() ENDPROC qPROCEDURE Click LOCAL aListItems,lSorted,nTmpLen,nTmpLen2,cValue,i IF this.Parent.lstLeft.ListCount = 0 RETURN ENDIF * Check for maxitems IF this.Parent.MaxItems>0 AND; (THIS.Parent.lstLeft.ListCount+THIS.Parent.lstRight.ListCount) > this.Parent.MaxItems IF !EMPTY(THIS.Parent.MaxMessage) AND TYPE("THIS.Parent.MaxMessage")="C" MESSAGEBOX(THIS.Parent.MaxMessage) ENDIF RETURN ENDIF THISFORM.LOCKSCREEN = .T. lSorted = this.Parent.lstRight.Sorted this.Parent.lstRight.Sorted = .F. cValue = this.Parent.lstLeft.Value IF THIS.Parent.UseArrays DIMENSION aListItems[ALEN(THIS.Parent.aChoices,1),1] =ACOPY(THIS.Parent.aChoices,aListItems) ELSE DIMENSION aListItems[this.Parent.lstLeft.ListCount,1] FOR m.i = 1 to this.Parent.lstLeft.ListCount aListItems[m.i,1] = this.Parent.lstLeft.List[m.i] ENDFOR ENDIF this.Parent.lstLeft.clear() THIS.Parent.POPLIST(@aListItems,this.Parent.lstRight) this.Parent.Updated = .t. * Test for valid setting IF this.Parent.lstRight.listitemid = 0 this.Parent.lstRight.listitemid = 1 ENDIF IF this.Parent.lstRight.ListCount = 0 OR EMPTY(THIS.Parent.aSelections[1]) DIMENSION THIS.Parent.aSelections[ALEN(aListItems,1),2] FOR i = 1 TO ALEN(aListItems,1) THIS.Parent.aSelections[m.i,1] = aListItems[m.i] THIS.Parent.aSelections[m.i,2] = m.i && this assumes that Sorted is set off ENDFOR ELSE nTmpLen = ALEN(THIS.Parent.aSelections,1)+1 nTmpLen2 = ALEN(THIS.Parent.aSelections,1) + ALEN(aListItems,1) DIMENSION THIS.Parent.aSelections[m.nTmpLen2,2] FOR i = m.nTmpLen TO m.nTmpLen2 THIS.Parent.aSelections[m.i,1] = aListItems[m.i+1-m.nTmpLen] THIS.Parent.aSelections[m.i,2] = THIS.Parent.LstRight.IndexToItemId(m.i) ENDFOR ENDIF IF m.lSorted this.Parent.lstRight.Sorted = .T. ENDIF this.Parent.lstRight.Value = m.cValue this.Parent.Refresh THISFORM.LOCKSCREEN = .F. ENDPROC RPROCEDURE getdbcdata * Parameter is short name passed -- not DBC() * DBC() should already be open so just select it. Since Wizards are modal, * we can prevent user from manually closing a DBC. LPARAMETERS cDBCName LOCAL nDBCCount,i,cTmpListStr,nScanPos,cTmpAlias,nViewCount LOCAL aTmpArr,aTmpArr2,aDBCTables,nTblCount,cTmpView,cOldExcl DIMENSION aTmpArr[1] DIMENSION aTmpArr2[1] DIMENSION aDBCTables[1] m.cTmpAlias = "" m.cTmpListStr = "" m.cDBCName = ALLTRIM(m.cDBCName) IF EMPTY(m.cDBCName) RETURN ENDIF SET DATABASE TO (m.cDBCName) *- Quick Check to make sure DBC open and selected IF EMPTY(DBC()) && Should never happen unless somehow closed while in moverlist. * Try to open it cOldExcl = SET("EXCL") DO CASE CASE TYPE("THIS.ExclusiveSet")#"N" CASE THIS.ExclusiveSet = 1 SET EXCLUSIVE OFF CASE THIS.ExclusiveSet = 2 SET EXCLUSIVE ON ENDCASE OPEN DATA (m.cDBCName) && note -- we don't keep track of DBC paths so we can only go by what's in list SET EXCLUSIVE &cOldExcl IF EMPTY(DBC()) && had an error RETURN ENDIF ENDIF THIS.CurrentDBC = DBC() && set current DBC property *- Update Dropdown list only if necessary IF THIS.cboData.ListCount=0 && no free table entry in list THIS.cboData.AddItem(C_FREETABLE_LOC) ENDIF IF THIS.cboData.ListCount=1 && new database THIS.cboData.AddItem("\-") ENDIF FOR i = 1 TO THIS.cboData.ListCount IF ALLTRIM(THIS.cboData.listitem[m.i]) = m.cDBCName EXIT ENDIF ENDFOR IF ALLTRIM(THIS.cboData.listitem[m.i]) # m.cDBCName THIS.cboData.AddItem(m.cDBCName) ENDIF THIS.cboData.VALUE = m.cDBCName *- Update listboxes m.nDBCCount = ADBOBJ(aTmpArr,"TABLE") && get tables m.nViewCount = ADBOBJ(aTmpArr2,"VIEW") && get views * Skip for views IF !THIS.AllowViews m.nViewCount = 0 ENDIF IF m.nViewCount > 1 * sort by view type FOR i = m.nViewCount TO 1 STEP -1 IF DBGETPROP(aTmpArr2[m.i],"view","sourcetype") = 2 && remote view m.cTmpView = aTmpArr2[m.i] =ADEL(aTmpArr2,m.i) aTmpArr2[m.nViewCount] = m.cTmpView ENDIF ENDFOR ENDIF IF m.nDBCCount+m.nViewCount = 0 && no tables in DBC SELECT 0 ELSE DIMENSION aDBCTables[m.nDBCCount+m.nViewCount,2] FOR i = 1 TO m.nDBCCount aDBCTables[m.i,1] = aTmpArr[m.i] && name aDBCTables[m.i,2] = FULL(DBGETPROP(aTmpArr[m.i],'TABLE','path'),DBC()) ENDFOR FOR i = 1 TO m.nViewCount aDBCTables[m.i+m.nDBCCount,1] = aTmpArr2[m.i] aDBCTables[m.i+m.nDBCCount,2] = aTmpArr2[m.i] && name ENDFOR ENDIF * Reset controls THIS.lstTables.CLEAR() IF THIS.RefreshFields THIS.lstLeft.CLEAR() THIS.cmdAdd.Enabled = .F. THIS.cmdAddAll.Enabled = .F. IF !THIS.MultiTable THIS.lstRight.CLEAR() THIS.cmdRemove.Enabled = .F. THIS.cmdRemoveAll.Enabled = .F. ENDIF ENDIF IF m.nDBCCount > 0 * Update Tables List with ADBOBJ contents * Exclude aSkipTables items FOR i = 1 TO m.nDBCCount IF ASCAN(aSkipTables,aDBCTables[m.i,2])#0 OR; aDBCTables[m.i,2]==UPPER(THIS.ExclDBF) LOOP ENDIF this.lstTables.AddItem(UPPER(aDBCTables[m.i,1])) ENDFOR * Add Tables list BMPS THIS.lstTables.Picture[0] = BMP_TABLE ENDIF m.nTblCount = THIS.lstTables.ListCount IF m.nViewCount > 0 * Update Tables List with ADBOBJ contents * Exclude aSkipTables items m.cTmpListStr = "" FOR i = 1 TO m.nViewCount IF UPPER(aTmpArr2[m.i])==UPPER(THIS.ExclDBF) LOOP ENDIF this.lstTables.AddItem(UPPER(aTmpArr2[m.i])) ENDFOR FOR i = (m.nTblCount+1) TO THIS.lstTables.ListCount IF DBGETPROP(ALLTRIM(THIS.lstTables.List[m.i]),"view","sourcetype") = 1 &&local view THIS.lstTables.Picture[m.i] = BMP_LOCAL ELSE THIS.lstTables.Picture[m.i] = BMP_REMOTE ENDIF ENDFOR ENDIF * Test if selected DBF is in DBC or excluded IF !EMPTY(ALIAS()) IF THIS.GetDBCName() == DBC() AND; ASCAN(aSkipTables,DBF()) = 0 AND; UPPER(THIS.ExclDBF) # DBF() DO CASE CASE CURSORGETPROP("SourceType") = 3 && normal table m.nScanPos = ASCAN(aDBCTables,DBF()) IF m.nScanPos # 0 THIS.DBCTable = aDBCTables[m.nScanPos-1] THIS.lstTables.Value = THIS.DBCTable ELSE SELECT 0 && we have unknown reference to alias which could not be resolved ENDIF OTHERWISE * Have a view here m.nScanPos = ASCAN(aTmpArr2,ALIAS()) IF !THIS.AllowViews OR m.nScanPos = 0 SELECT 0 ELSE THIS.DBCTable = ALIAS() THIS.lstTables.Value = THIS.DBCTable ENDIF ENDCASE ELSE SELECT 0 && in case we fail -- for next step ENDIF ENDIF * Now try to select/open a table in ADBOBJ array IF EMPTY(ALIAS()) FOR i = 1 TO (m.nDBCCount+m.nViewCount) IF ASCAN(aSkipTables,aDBCTables[m.i,2]) # 0 OR; UPPER(THIS.ExclDBF)==aDBCTables[m.i,2] LOOP ENDIF THIS.GetDBCTable(aDBCTables[m.i,1]) IF !EMPTY(ALIAS()) THIS.DBCTable = aDBCTables[m.i,1] THIS.lstTables.Value = THIS.DBCTable EXIT ENDIF ENDFOR ENDIF IF !EMPTY(ALIAS()) THIS.GetTableData() && populate field listboxes ENDIF THIS.lstTables.Enabled = (THIS.lstTables.ListCount#0) * Quick check IF THIS.lstTables.ListCount#0 AND THIS.lstTables.ListIndex=0 THIS.lstTables.ListIndex = 1 ENDIF ENDPROC PROCEDURE usetable LPARAMETER cGetDBF,lUseExcl LOCAL cTmpAlias,nTmpCount,cAlias,cOldSafe,badchars,goodchars,i,cOldExcl lUseExcl = IIF(PCOUNT()>1,"EXCLUSIVE","SHARED") cAlias= THIS.JUSTSTEM(m.cGetDBF) * Check to make sure we have valid characters in are alias since * DBCs can store names of tables\views with any character. IF VERSION(3) $ DBCS_LOC m.badchars = '/,-=:;!@#$%&*.<>()?'+; '+'+CHR(34)+CHR(39)+" " ELSE m.badchars = '/\,-=:;{}[]!@#$%^&*.<>()?'+; '+|'+; ''+CHR(34)+CHR(39)+" " ENDIF * Let's set the true bad characters which aren't allowed in fields * Note: this will differ based on code page m.goodchars="" FOR i = 1 TO LEN(m.badchars) IF ISALPHA(SUBSTR(m.badchars,m.i,1)) m.goodchars = m.goodchars + SUBSTR(m.badchars,m.i,1) ENDIF ENDFOR m.badchars = CHRTRAN(m.badchars,m.goodchars,'') m.cAlias = CHRTRAN(m.cAlias,m.badchars,REPLICATE("_",LEN(m.badchars))) * Test if alias is a numeric name and precede it with "_" * so that it doesn't conflict with workarea number. IF ISDIGIT(m.cAlias) m.cAlias= '_'+m.cAlias ENDIF m.cTmpAlias = m.cAlias SELECT 0 * Test for ALIAS name already being used m.nTmpCount = 1 DO WHILE .T. IF !USED(m.cTmpAlias) EXIT ENDIF m.cTmpAlias = m.cAlias + "_"+ALLT(STR(m.nTmpCount)) m.nTmpCount = m.nTmpCount+ 1 ENDDO * Trap for error here -- update 3.0 tables in DBC THIS.SKIPERROR =.T. m.cOldSafe = SET("SAFETY") SET SAFETY OFF && to prevent 3.0 conversion dialog from appearing m.cOldExcl = SET("EXCL") DO CASE CASE TYPE("THIS.ExclusiveSet")#"N" CASE THIS.ExclusiveSet = 1 SET EXCLUSIVE OFF CASE THIS.ExclusiveSet = 2 SET EXCLUSIVE ON ENDCASE IF THIS.ViewNoData && for Views - only get structure USE (m.cGetDBF) AGAIN NODATA ALIAS (m.cTmpAlias) &lUseExcl ELSE USE (m.cGetDBF) AGAIN ALIAS (m.cTmpAlias) &lUseExcl ENDIF THIS.SKIPERROR =.F. SET SAFETY &cOldSafe SET EXCLUSIVE &cOldExcl * Failed to open table IF EMPTY(ALIAS()) RETURN ENDIF * check if it is a readonly table and Form wizard IF ISREADONLY() AND TYPE('THIS.AllowReadOnly')="L" AND !THIS.AllowReadOnly * Wizard does not allow ReadOnly Tables USE THIS.ALERT(C_READONLY_LOC) RETURN ENDIF * Let's update arrays here IF EMPTY(THIS.GetDBCName()) && Free table IF !EMPTY(aDBFList[1]) DIMENSION aDBFList[ALEN(aDBFList,1)+1,2] ENDIF aDBFList[ALEN(aDBFList,1),1] = DBF() aDBFList[ALEN(aDBFList,1),2] = ALIAS() THIS.lstTables.AddItem(ALIAS()) ELSE && DBC * Need to update aDBCList array IF !EMPTY(aDBCList[1]) DIMENSION aDBCList[ALEN(aDBCList,1)+1,2] ENDIF IF CURSORGETPROP("SourceType")#3 aDBCList[ALEN(aDBCList,1),1] = CURSORGETPROP("SourceName") ELSE aDBCList[ALEN(aDBCList,1),1] = DBF() ENDIF aDBCList[ALEN(aDBCList,1),2] = ALIAS() ENDIF ENDPROC PROCEDURE getdbctable LPARAMETER cDBCTable &&this is shortname of table LOCAL cDBFName,aTmpArr,m.i DIMENSION aTmpArr[1] m.cDBFName = "" DO CASE CASE aDBOBJ(aTmpArr,"table")>0 AND ASCAN(aTmpArr,UPPER(m.cDBCTable), 1, 3)#0 m.cDBFName = FULL(DBGETPROP(m.cDBCTable,'TABLE','path'),DBC()) FOR m.i = 1 TO ALEN(aDBCList,1) IF !EMPTY(aDBCList[m.i,1]) AND CursorGetProp("sourcetype",aDBCList[m.i,2]) = 3 AND ; m.cDBFName == aDBCList[m.i,1] SELECT (aDBCList[m.i,2]) RETURN ENDIF ENDFOR CASE aDBOBJ(aTmpArr,"view")>0 AND ASCAN(aTmpArr,UPPER(m.cDBCTable), 1, 3)#0 m.cDBFName = UPPER(m.cDBCTable) FOR m.i = 1 TO ALEN(aDBCList,1) IF !EMPTY(aDBCList[m.i,1]) AND CursorGetProp("sourcetype",aDBCList[m.i,2]) # 3 AND ; m.cDBFName == aDBCList[m.i,1] && it's a view SELECT (aDBCList[m.i,2]) RETURN ENDIF ENDFOR OTHERWISE RETURN ENDCASE * Try to open file THIS.USETABLE(m.cDBFName) * Quick test to see if we have a valid DBF (i.e., Backlink) IF !EMPTY(ALIAS()) AND EMPTY(THIS.GetDBCName()) THIS.ALERT(E_BADDBCTABLE_LOC) ENDIF ENDPROC PROCEDURE getfreedata LOCAL cCurrData,nCount cCurrData = SET("DATABASE") SET DATABASE TO IF THIS.cboData.ListCount=0 &&no free table entry in list THIS.cboData.AddItem(C_FREETABLE_LOC) ENDIF THIS.cboData.Value=C_FREETABLE_LOC THIS.lstTables.Clear() THIS.lstTables.Picture[0] = "" &&no bmp for tables IF !EMPTY(aDBFList[1]) IF UPPER(THIS.ExclDBF)==DBF() SELECT 0 ENDIF FOR nCount = 1 TO ALEN(aDBFList,1) IF UPPER(THIS.ExclDBF)==UPPER(aDBFList[m.nCount,1]) LOOP ENDIF THIS.lstTables.AddItem(aDBFList[m.nCount,2]) IF EMPTY(ALIAS()) IF USED(aDBFList[m.nCount,2]) SELECT (aDBFList[m.nCount,2]) ENDIF ENDIF ENDFOR THIS.lstTables.Value = ALIAS() ELSE SELECT 0 ENDIF * Populate fields list THIS.GetTableData() * Quick check IF THIS.lstTables.ListCount#0 AND THIS.lstTables.ListIndex=0 THIS.lstTables.ListIndex = 1 ENDIF IF !THIS.lstTables.ENABLED AND !EMPTY(ALIAS()) THIS.lstTables.ENABLED = .T. ENDIF ENDPROC PROCEDURE opentable LOCAL cGetDBF,sOldSafe,nPos,cOldExcl LOCAL sOldArea,cCurrDBC,cTmpDbc m.sOldSafe=SET('SAFETY') SET SAFETY OFF && needed for missing CDX file error m.sOldArea = SELECT() m.cCurrDBC=DBC() SET DATABASE TO DO WHILE .T. m.cGetDBF="" m.cGetDBF = GETFILE('DBF|DBC',C_TPROMPT_LOC) IF EMPTY(m.cGetDBF) * Reset -- user canceled out IF EMPTY(m.cCurrDBC) SET DATABASE TO ELSE SET DATABASE TO (m.cCurrDBC) ENDIF SELECT (m.sOldArea) EXIT ENDIF * Check if excluded file picked IF ASCAN(aSkipTables,m.cGetDBF, 1, 3) # 0 OR UPPER(THIS.ExclDBF)==m.cGetDBF m.cGetDBF="" IF EMPTY(m.cCurrDBC) SET DATABASE TO ELSE SET DATABASE TO (m.cCurrDBC) ENDIF SELECT (m.sOldArea) THIS.ALERT(C_READ3_LOC) EXIT ENDIF * Check if DBC picked IF RIGHT(m.cGetDBF,4)=".DBC" THIS.SKIPERROR =.T. cOldExcl = SET("EXCL") DO CASE CASE TYPE("THIS.ExclusiveSet")#"N" CASE THIS.ExclusiveSet = 1 SET EXCLUSIVE OFF CASE THIS.ExclusiveSet = 2 SET EXCLUSIVE ON ENDCASE OPEN DATABASE (m.cGetDBF) && note: this doesn't affect DBCALIAS. SET EXCLUSIVE &cOldExcl THIS.SKIPERROR =.F. IF EMPTY(DBC()) && failed to open LOOP ELSE EXIT ENDIF ENDIF * Check if file already used in DBC. nPos = ASCAN(aDBCList,m.cGetDBF, 1, 3) IF m.nPos # 0 SELECT (aDBCList[m.nPos+1]) m.cTmpDbc = THIS.GetDBCName() IF DBC()#THIS.GetDBCName() SET DATABASE TO (m.cTmpDbc) ENDIF EXIT ENDIF * Check if file already used. nPos = ASCAN(aDBFList,m.cGetDBF, 1, 3) IF m.nPos # 0 SELECT (aDBFList[m.nPos+1]) EXIT ENDIF * Try to open it if not already opened. THIS.UseTable(m.cGetDBF,.T.) IF !EMPTY(ALIAS()) && successfully opened file EXIT ENDIF ENDDO SET SAFETY &sOldSafe RETURN m.cGetDBF ENDPROC PROCEDURE moverrefresh * This routine refreshes mover list LPARAMETER lRefresh,lQuickPass,cSaveLstValue LOCAL lOldRefresh,aTmpData,i,aPopItems * lRefresh - calls TblMover routines which repopulate lstTables and popups * lQuickPass - does a quick restore and returns if environment stayed same m.lOldRefresh = IIF(TYPE("THIS.RefreshFields")="L",THIS.RefreshFields,.T.) m.lQuickPass = IIF(TYPE("m.lQuickPass")="L",m.lQuickPass,.F.) THIS.RefreshFields = IIF(PARAMETER()#0 AND TYPE("m.lRefresh")="L",m.lRefresh,m.lOldRefresh) THIS.RefreshCurrent = IIF(TYPE("THIS.RefreshCurrent")="L",THIS.RefreshCurrent,.T.) IF THIS.RefreshCurrent &&update to current DBC,ALIAS() THIS.CurrentDBC = DBC() THIS.CurrentAlias = ALIAS() ENDIF * Update dropdown list if necessary DIMENSION aTmpData[1,2] DIMENSION aPopItems[1] STORE "" TO aTmpData,aPopItems IF ADATA(aTmpData)>0 IF THIS.cboData.ListCount=0 &&no free table entry in list THIS.cboData.AddItem(C_FREETABLE_LOC) ENDIF IF THIS.cboData.ListCount=1 &&free table only in list THIS.cboData.AddItem("\-") ENDIF DIMENSION aPopItems[THIS.cboData.ListCount] FOR i = 1 TO THIS.cboData.ListCount aPopItems[m.i] = ALLTRIM(THIS.cboData.listitem[m.i]) ENDFOR FOR i = 1 TO ALEN(aTmpData,1) IF ASCAN(aPopItems,aTmpData[m.i,1]) = 0 THIS.cboData.AddItem(aTmpData[m.i,1]) ENDIF ENDFOR ENDIF * Restore necessary data IF !EMPTY(THIS.CurrentAlias) IF USED(THIS.CurrentAlias) SELECT (THIS.CurrentAlias) ELSE THIS.RefreshFields = .T. THIS.CurrentAlias= "" SELECT 0 ENDIF ELSE THIS.RefreshFields = .T. ENDIF IF !EMPTY(THIS.CurrentAlias) AND THIS.ExclDBF==DBF(THIS.CurrentAlias) THIS.RefreshFields = .T. THIS.CurrentAlias= "" SELECT 0 ENDIF cSaveLstValue = IIF(EMPTY(THIS.CurrentAlias),"",THIS.lstTables.Value) IF !EMPTY(THIS.CurrentDBC) *- Handle DBC Table SET DATABASE TO (THIS.CurrentDBC) IF THIS.RefreshFields OR !m.lQuickPass THIS.cboData.Value = THIS.GetDBCAlias() THIS.GetDBCData(THIS.cboData.Value) ENDIF ELSE *- Handle free tables THIS.GetFreeData() ENDIF IF !EMPTY(m.cSaveLstValue) THIS.lstTables.Value = m.cSaveLstValue ENDIF THIS.RefreshFields = m.lOldRefresh ENDPROC PROCEDURE getdbcalias * Takes the current DBC and gets its alias name * cDBC - DBC name passed if not current DBC() LPARAMETER cDBC LOCAL aDBCtmp,cGetDBC,nPos IF TYPE("m.cDBC") # "C" m.cDBC ="" ENDIF IF EMPTY(m.cDBC) AND EMPTY(DBC()) RETURN "" ENDIF m.cGetDBC = IIF(EMPTY(m.cDBC),DBC(),UPPER(m.cDBC)) DIMENSION aDBCtmp[1,2] =ADATA(aDBCtmp) m.nPos = ASCAN(aDBCtmp,m.cGetDBC) RETURN IIF(m.nPos = 0,"",aDBCtmp[m.nPos-1]) ENDPROC PROCEDURE getdbcname lparameters xx LOCAL m.Retval IF TYPE("m.XX") = 'L' xx = select() ENDIF m.retval = CursorGetProp("database",m.xx) IF !EMPTY(m.retval) AND !EMPTY(DBC()) && could be a repackaged cursor: check if in dbc() IF CursorGetProp("sourcetype",m.xx) = 3 AND !INDBC(CursorGetProp("sourcename",m.xx),"table") OR ; CursorGetprop("sourcetype",m.xx) # 3 AND !INDBC(CursorGetProp("sourcename",m.xx),"view") m.retval="" ENDIF ENDIF RETURN m.retval ENDPROC PROCEDURE initdata LOCAL nTotWorkAreas,nCount,i,cCurrDBC,aDBC,nWorkArea LOCAL cOldExact,nTotTables,lIsInDBC,aWorkAreas * Setup custom properties and arrays THIS.INITVARS THIS.ADDTOARRAY(@aSkipTables,"FORMSTYLES") DIMENSION aDBFList[1,2] DIMENSION aDBCList[1,2] DIMENSION aWorkAreas[1] DIMENSION aDBC[1] STORE "" TO aDBFList,aDBCList,aDBC,aWorkAreas cOldExact = SET("EXACT") SET EXACT ON m.lIsInDBC = .F. * Need to transform aSkipTables from Aliases to DBFs for DBC tables FOR i = 1 TO ALEN(aSkipTables,1) IF !EMPTY(aSkipTables[m.i,1]) AND USED(aSkipTables[m.i,1]) aSkipTables[m.i] = DBF(aSkipTables[m.i,1]) ENDIF ENDFOR * Add Free Table DBC popup items THIS.cboData.AddItem(C_FREETABLE_LOC) THIS.cboData.Value = C_FREETABLE_LOC m.nDBCCount=ADATABASES(aDBC) FOR i = 1 TO m.nDBCCount * Add bar for popup IF m.i = 1 THIS.cboData.AddItem("\-") ENDIF THIS.cboData.AddItem(aDBC[m.i,1]) ENDFOR * Go thru workareas and see which tables open m.nTotWorkAreas = AUSED(aWorkAreas) FOR m.nCount = 1 TO m.nTotWorkAreas m.nWorkArea = aWorkAreas[m.nCount,2] * Avoid specific tables used by wizard and not in a DBC DO CASE CASE ASCAN(aSkipTables,DBF(m.nWorkArea))#0 LOOP CASE ISREADONLY(m.nWorkArea) AND !THIS.AllowReadOnly * skip for read-only tables and queries LOOP CASE EMPTY(THIS.GetDBCName(m.nWorkArea)) * Add to free tables list IF ATC(".TMP",DBF(m.nWorkArea))#0 AND !THIS.AllowQuery LOOP ENDIF IF !EMPTY(aDBFList[1]) DIMENSION aDBFList[ALEN(aDBFList,1)+1,2] ENDIF aDBFList[ALEN(aDBFList,1),1] = DBF(m.nWorkArea) aDBFList[ALEN(aDBFList,1),2] = ALIAS(m.nWorkArea) OTHERWISE * Need to determine if its a Table, Local View or Remote View * Add to DBC tables list IF !THIS.AllowViews AND CURSORGETPROP("sourcetype",m.nWorkArea)#3 LOOP ENDIF IF !EMPTY(aDBCList[1]) DIMENSION aDBCList[ALEN(aDBCList,1)+1,2] ENDIF IF CURSORGETPROP("sourcetype",m.nWorkArea)#3 &&handle view here aDBCList[ALEN(aDBCList,1),1] = UPPER(CURSORGETPROP("sourcename",m.nWorkArea)) ELSE aDBCList[ALEN(aDBCList,1),1] = DBF(m.nWorkArea) ENDIF aDBCList[ALEN(aDBCList,1),2] = ALIAS(m.nWorkArea) ENDCASE ENDFOR =ASORT(aDBFList,1) *- Now try to select a specific table *- Default order for choosing: *- 1. Open in current workarea *- 2. Selected DBC() *- 3. First free table *- 4. First DBC *- Get Selected Table, Database info THIS.CurrentDBC = DBC() m.cCurrDBC = "" && DBCAlias of selected ALIAS() -- not necessarily same as current DBC * See if we need to skip selected alias IF !EMPTY(ALIAS()) DO CASE CASE ASCAN(aSkipTables,DBF())# 0 * Check if table selected in aSkipTables array SELECT 0 CASE !THIS.AllowReadOnly AND ISREADONLY() * Skip if read-only file SELECT 0 CASE EMPTY(THIS.GetDBCName()) AND !THIS.AllowQuery AND ATC(".TMP",DBF()) # 0 * Skip for FoxPro 2.6 Cursors SELECT 0 CASE !THIS.AllowViews AND CURSORGETPROP("sourcetype")#3 * Skip if a view SELECT 0 ENDCASE ENDIF * Try to select a table DO CASE CASE !EMPTY(ALIAS()) && use alias already selected m.cCurrDBC = THIS.GetDBCName() && returns DBC m.lIsInDBC = !EMPTY(m.cCurrDBC) IF m.lIsInDBC AND DBC()#m.cCurrDBC && make sure we have right DBC selected SET DATABASE TO (m.cCurrDBC) ENDIF CASE !EMPTY(DBC()) && use current DBC m.lIsInDBC = .T. CASE !EMPTY(aDBFList[1]) && use first available free table SELECT (aDBFList[1,2]) CASE !EMPTY(aDBC[1]) && use first available DBC m.lIsInDBC = .T. SET DATABASE TO (aDBC[1]) ENDCASE IF m.lIsInDBC AND !EMPTY(ALIAS()) LOCAL csName csName = CURSORGETPROP('sourcename') IF THIS.ALLOWQUERY AND ATC(".TMP",DBF())#0 ; AND m.csName # ALIAS() AND USED(m.csName); AND m.csName # DBF() IF !EMPTY(aDBFList[1]) DIMENSION aDBFList[ALEN(aDBFList,1)+1,2] ENDIF aDBFList[ALEN(aDBFList,1),1] = DBF() aDBFList[ALEN(aDBFList,1),2] = ALIAS() m.lIsInDBC = .f. ENDIF ENDIF IF m.lIsInDBC *Populate object with DBC data THIS.CurrentDBC = DBC() THIS.cboData.Value = THIS.GetDBCAlias() THIS.GetDBCData(THIS.cboData.Value) ELSE *Populate object with Free Table data THIS.GetFreeData() ENDIF * Check if no tables found for table list IF THIS.lstTables.ListCount = 0 THIS.lstTables.enabled= .F. THIS.lstLeft.enabled= .F. THIS.lstRight.enabled= .F. ENDIF SET EXACT &cOldExact ENDPROC PROCEDURE initvars DODEFAULT() THIS.ExclDBF = IIF(TYPE("THIS.ExclDBF")="C",THIS.ExclDBF,"") THIS.RefreshFields = IIF(TYPE("THIS.RefreshFields")="L",THIS.RefreshFields,.T.) THIS.ViewNoData = IIF(TYPE("THIS.ViewNoData")="L",THIS.ViewNoData,.T.) THIS.AllowViews = IIF(TYPE("THIS.AllowViews")="L",THIS.AllowViews,.T.) THIS.AllowQuery = IIF(TYPE("THIS.AllowQuery")="L",THIS.AllowQuery,.F.) * aSkipTables is array of aliases to skip -- those * which may be used by Wizard itself. PUBLIC aSkipTables,aDBFList,aDBCList * see if already defined since we are using Public for now IF TYPE("aSkipTables[1]") # "C" DIMENSION aSkipTables[1] aSkipTables = "" ENDIF IF TYPE("aDBFList[1]") # "C" DIMENSION aDBFList[1,2] aDBFList= "" ENDIF IF TYPE("aDBCList[1]") # "C" DIMENSION aDBCList[1,2] aDBCList = "" ENDIF ENDPROC PROCEDURE Destroy DODEFAULT() IF !THIS.lPublicsInUse RELEASE aDBFList,aDBCList,aSkipTables ENDIF ENDPROC PROCEDURE Error Parameters nError, cMethod, nLine *- handle conversion of old DBC files containing 2.5 tables IF THIS.SKIPERROR IF nError = 1977 USE (m.cGetDBF) EXCLUSIVE RETURN ENDIF ENDIF * Otherwise pass things along DODEFAULT(nError, cMethod, nLine) ENDPROC PROCEDURE Init IF TYPE("aSkipTables")#"U" THIS.lPublicsInUse = .T. ENDIF DoDefault() ENDPROC 9 99 %38_3UE        T T T C %C BG( %CCꖡT CEXCLv HD% CTHIS.ExclusiveSetbN *G DG  SET EXCLUSIVE &cOldExcl %CCꖡBT C% C Free Tables % C\- ( K"%CC   G!"%CC   C T  T CTABLET CVIEW%  T %   (/%CC view sourcetypeT C C T  %  F  ( `"T C 9T CCC TABLEpathCꖻ( (T  C (T  C C % nC T -T -%  jC T -T -% )( <%C!C  C  C "f .CCC  f $T # dbtable.bmpT  % {T ( %CC fC "f.CCC f $ ( w7%CCC  $view sourcetypeE&T #  dblview.bmps&T #  dbrview.bmp%CC 5%C %CC!C& C "fC&  H C SourceTypeZT C C&% FT &C  T  &VF2T CC%   FT &CT  &F%CC (   <%C!C  C "fC   X .CC  '%CC  T &C  T  &!%CC  C (T  (%  ) > T )U*CDBCNAME NDBCCOUNTI CTMPLISTSTRNSCANPOS CTMPALIAS NVIEWCOUNTATMPARRATMPARR2 ADBCTABLES NTBLCOUNTCTMPVIEWCOLDEXCLTHIS EXCLUSIVESET CURRENTDBCCBODATA LISTCOUNTADDITEMLISTITEMVALUE ALLOWVIEWS LSTTABLESCLEAR REFRESHFIELDSLSTLEFTCMDADDENABLED CMDADDALL MULTITABLELSTRIGHT CMDREMOVE CMDREMOVEALL ASKIPTABLESEXCLDBFPICTURELIST GETDBCNAMEDBCTABLE GETDBCTABLE GETTABLEDATA LISTINDEX # .TCCt EXCLUSIVE SHARED6TC %Ch 81 82 86 888T /,-=:;!@#$%&*.<>()?+C" C'  T 8/\,-=:;{}[]!@#$%^&*.<>()?2+|/C" C'  T (C >%CC  \9!T  C  \T C  %T C  C_C >Q%C kT _ T  FT  +a%C  ! T  _CC ZT  T aT CSAFETYvG.T CEXCLv HC% CTHIS.ExclusiveSetbNh G G % ?USE (m.cGetDBF) AGAIN NODATA ALIAS (m.cTmpAlias) &lUseExcl .7USE (m.cGetDBF) AGAIN ALIAS (m.cTmpAlias) &lUseExcl T -SET SAFETY &cOldSafe SET EXCLUSIVE &cOldExcl %CCB8%CsCTHIS.AllowReadOnlybL   &Q]CMFile is read-only and not allowed by this application. Please select another. B%CC %CC nCTCC&TCCCC %CC C%C SourceTypeG,TCC SourceNamemTCC&TCCUCGETDBFLUSEEXCL CTMPALIAS NTMPCOUNTCALIASCOLDSAFEBADCHARS GOODCHARSICOLDEXCLTHISJUSTSTEM SKIPERROR EXCLUSIVESET VIEWNODATA ALLOWREADONLYALERT GETDBCNAMEADBFLIST LSTTABLESADDITEMADBCLIST  T  HA%: CtableCC f 8(T CC TABLEpathCꖻ (C4V%CC  "C sourcetypeC   C  0FC B9 CviewCC f T C f (CV%CC  "C sourcetypeC   C  FC B2%BC %CC CC C>The table selected does not have a valid backlink to its DBC. <You can fix this with the VALIDATE DATABASE RECOVER command.U CDBCTABLECDBFNAMEATMPARRIADBCLISTTHISUSETABLE GETDBCNAMEALERT/ TCDATABASEvG(%]C Free TablesT Free TablesCT %CC %C fC&F(C "%C fCC  f .CC  %CC%CC  |FC  TCF C (%  T % CC (TaU CCURRDATANCOUNTTHISCBODATA LISTCOUNTADDITEMVALUE LSTTABLESCLEARPICTUREADBFLISTEXCLDBF GETTABLEDATA LISTINDEXENABLEDT CSAFETYvG.T CWT CG( +aT /T CDBF|DBCSelect file to open:%C %C G(G(  F !2%C C f  T %C ZG(pG(  F /CFile is in use. Select another. !%C R.DBCT aTCEXCLv HZ% CTHIS.ExclusiveSetbN&  @G  ZG  SET EXCLUSIVE &cOldExcl T -%CCꖡ.!TC % <FC  T C%CC4G( !TC % FC !C a%CC !SET SAFETY &sOldSafe B UCGETDBFSOLDSAFENPOSCOLDEXCLSOLDAREACCURRDBCCTMPDBC ASKIPTABLESTHISEXCLDBFALERT SKIPERROR EXCLUSIVESETADBCLIST GETDBCNAMEADBFLISTUSETABLE\7T CCTHIS.RefreshFieldsbL a60T CC m.lQuickPassbL -6=TCCC m.lRefreshbL   69T CCTHIS.RefreshCurrentbL  a6% .T CT C J(%C% C Free Tables % C\-  ( 6$T CC  (C"%CC CC  %C %C  F TaT FTa&%C C & lTaT F&TCC  6%C G( %  T CC  C%C  CT T ULREFRESH LQUICKPASS CSAVELSTVALUE LOLDREFRESHATMPDATAI APOPITEMSTHIS REFRESHFIELDSREFRESHCURRENT CURRENTDBC CURRENTALIASCBODATA LISTCOUNTADDITEMLISTITEMEXCLDBF LSTTABLESVALUE GETDBCALIAS GETDBCDATA GETFREEDATA%Cm.cDBCbC?T %C CCꖡ f B%T CC CC f6CT C 'BC  C 6UCDBCADBCTMPCGETDBCNPOS! %Cm.XXbL4 TCWT Cdatabase %C  CCꖡ %C sourcetype "CC sourcename table >C sourcetype !CC sourcename view  T  B UXXRETVAL4 C FORMSTYLES    J( TCEXACTvG T -(C E-%CC  CC  A!T CC  &C Free Tables T  Free TablesT C( % C\- CC  T C y ( yT C  HTu C C &t. C s  . CC  Z)%C.TMPC &  .%CC C#TCC &#TCC 2u.%  C sourcetype  .%CC C#%C sourcetype #3TCCC sourcename fN#TCC &#TCC CT CT %CC u Hq C C&F  Cs F1 CC   C.TMPC& @F)  C sourcetype qF H] CC T C T C  %  C  G(  CCꖡ  T a CC ,FC CC ] T aG(C% CC bTC sourcenameF% C.TMPC& C C  C& ^%CC CTCC&TCC T -% T CT C C   C % T -T -T !-SET EXACT &cOldExact U" NTOTWORKAREASNCOUNTICCURRDBCADBC NWORKAREA COLDEXACT NTOTTABLESLISINDBC AWORKAREASTHISINITVARS ADDTOARRAY ASKIPTABLESADBFLISTADBCLISTCBODATAADDITEMVALUE NDBCCOUNT ALLOWREADONLY GETDBCNAME ALLOWQUERY ALLOWVIEWS CURRENTDBCCSNAME GETDBCALIAS GETDBCDATA GETFREEDATA LSTTABLES LISTCOUNTENABLEDLSTLEFTLSTRIGHT C4TCC THIS.ExclDBFbC 68TCCTHIS.RefreshFieldsbL a65TCCTHIS.ViewNoDatabL a65TCCTHIS.AllowViewsbL a65TCCTHIS.AllowQuerybL -67"%CaSkipTables[1]bC_  T%C aDBFList[1]bC T%C aDBCList[1]bC TU THISEXCLDBF REFRESHFIELDS VIEWNODATA ALLOWVIEWS ALLOWQUERY ASKIPTABLESADBFLISTADBCLIST0 C% )<UTHIS LPUBLICSINUSEADBFLISTADBCLIST ASKIPTABLESb4%F%B Q BCUNERRORCMETHODNLINETHIS SKIPERRORCGETDBF=%C aSkipTablesbU-Ta CUTHIS LPUBLICSINUSE getdbcdata,usetable) getdbctable getfreedata opentable moverrefresh( getdbcaliasy# getdbcname$initdata%initvarsX/Destroy1Error2Init21u2AA2QAaAaAAAAsAqQA!AAA!aARA2a!qAAA!AAAAA2AAACAR2AAABqaaAAASQ1aARaAAAAAAaAAAAA1A22q AAARaA!AAQAqaQQAaAaAqAAABAA5AA!BAAA3qbAAAA1bAAAAAA3A2qarABQA!AAAAAA!A1AA31raaaAAA#aAAA1QAaAaAAAAA1A1QAAA1AAACAAB31vA3aqAqQA1AA!AAA3!AAbAb2qaAA"QA"3tAAR2r3qAAA3111AaAAA2QAACABAAAA11AAAA111A1AA qAA1AAAAAqcAAAAqaAsA3BQQQ#A1A1A3A2!AAAS3A1^} E$:g$#(a'C(a/n/$8F89;:;T;9Mg8XMPLPP%QQR+Z1R{R:)9